% C-instruction coder - writes to files *.c *.h

wcode_c(II,Op,Reg,F,N):- make_ccode(II,Op,Reg,F,N).

make_ccode(II,Op,Reg,F,N):- % writes C-macro to *.h file
  c_instr(II,Op,Reg,F,N,Instr),!,  
  make_hcode(Instr).
make_ccode(II,Op,Reg,F,N):- % C-ified bytecode
  make_bcode(II,Op,Reg,F,N).

make_hcode(Instr):-c_trace(2,Instr),wchunk(Instr).

% makes the bytcode in *.c file
make_bcode(_II,Op,Reg,F,N):-
  fast_write('{'),fast_write(Op),fast_write(','),
  fast_write(Reg),fast_write(','),
  fast_write(N),fast_write(',"'),
  patch_specials(F,NewF),
  fast_write(NewF),fast_write('"},'),nl.

% writes hint about starting/ending a C-chunk
wspec_c(II,Op,Reg,_,N):- % begin chunk
  c_spec(II,FunSym,Instr),!,
  write_c_chunk(nl),wchunk(Instr),
  c_trace(1,Instr),
  nl,fast_write('{'),write(Op),fast_write(','),
  fast_write(Reg),fast_write(','),
  fast_write(N),fast_write(',(void *)'),write(FunSym),fast_write('},'),nl.
wspec_c(II,Op,Reg,F,N):- % end chunk: 
  c_spec_end(II,Op,Reg,F,N,Instr),!,
  c_trace(1,Instr),
  wchunk(Instr).

lwrite(L):-member(X,L),put_code(X),fail.
lwrite(_).

patch_specials(Name,NewName):-integer(Name),!,NewName=Name.
patch_specials(Name,NewName):-
  name(Name,Xs),B=92,Q=34, % i.e. = \ and "
  findall(Y,
     ( member(X,Xs), patch_it(X,B,Q,Y)
     ),
  Ys),
  name(NewName,Ys).

patch_it(B,B,_,Y):-!,(Y=B;Y=B).
patch_it(Q,B,Q,Y):-!,(Y=B;Y=Q).
patch_it(X,_,_,X).

write_c_chunk(G):-!,
  c_chunk_file(CF),
  telling(F),
  tell(CF),
  G,
  tell(F).

wchunk(C):-write_c_chunk((fast_write(C),nl)).

% starts and ends *.c file
c_decorate_file(Where):-c_chunk_file('wam.h'),!,
  c_decorate_file0(Where,wam_bp).
c_decorate_file(Where):-
  c_decorate_file0(Where,user_bp).

c_root(XX):-
  bb_val(predicate,chunk,Chunk),
  Chunk1 is Chunk+1,
  currpred(Pred/Arity-No/_),
  make_cmd0([Pred,"_",Arity,"_",No,"_",Chunk1],Xs),
  c_string(Xs,Ys),
  name(XX,Ys),
  bb_set(predicate,chunk,Chunk1).

c_string(Xs,Ys):-
% [L,R]="db",
  [L,R]="VW",
  findall(Y,(member(X,Xs),c_char(L,R,X,Cs),member(Y,Cs)),Ys).
  
c_char(L,R,Char,[Char]):-
   Char=\=L,Char=\=R,
   ( Char >= 97, Char =< 122; % a..z
     Char >= 65, Char =< 90;  % A..Z
     Char >= 48, Char =< 57;   % 0..9
     Char =:= 95               % _
   ),!.
c_char(L,R,Char,[L|Ys]):-name(Char,Xs),append(Xs,[R],Ys).


c_decorate_file0(header,ArrayName):-!,
  wchunk('/* please do not edit: generated by co.pl */'),
%  write('#include "../src/global.h"'),nl,
%  write('#include "../src/c_defs.h"'),nl,
% use -I ../src or similar with your C compiler
  write('#include "global.h"'),nl,
  write('#include "c_defs.h"'),nl,
  c_chunk_file(F_H),write('#include "'),write(F_H),write('"'),
  nl,nl,
  write('struct bp_instr '),
  write(ArrayName),write('[] = {'),
  nl.
c_decorate_file0(footer,ArrayName):-
  write('{255,0,0,"'),write(ArrayName),write('"}};'),nl,nl,
  write('bp_long '),
  write(ArrayName),
  write('_size=sizeof('),
  write(ArrayName),
  write(');'),nl,nl,
  c_threshold(Min,Max),
  make_cmd(['#define ',c_threshold_min,' ',Min],Cmd1), write(Cmd1),nl,
  make_cmd(['#define ',c_threshold_max,' ',Max],Cmd2), write(Cmd2),nl,nl.




%----------------------------
% TOOLS

% chunk generation internals

% flag No: true if in chunk, counts FunSym
c_check:-c_check0(_).

c_check0(No):-bb_val(c_chunk,in,No),integer(No).

% computes H-offsets (from H-at-beginnig-of-the C-chunk)

new_offset(O):-
  bb_val(predicate,offset,O),
  O1 is O+1,
  bb_set(predicate,offset,O1).

% retrieves H-offsets (from H-at-beginnig-of-the C-chunk)

get_offset(O):-
  bb_val(predicate,offset,O).

% lookup in mini-symbol table at P

c_find_fun(F,_,_,_):-integer(F),!,
  errmes(unexpected,integer(F)).
c_find_fun(F,N,No,K):-
  for(I,0,No),
    bb_val(fun_symbol,I,F),
    bb_val(fun_arity,I,N),
  !,
  K=I.
c_find_fun(F,N,No,No1):-
  No1 is No+1,
  bb_set(c_chunk,in,No1),
  bb_let(fun_symbol,No1,F),
  bb_let(fun_arity,No1,N),
  make_bcode(write_constant,6,0,F,N). % looks like write_constant 

% starts a chunk, starts to count its members at -1
c_chunk_begin(Name):-
  bb_let(c_chunk,in, -1),
  c_root(Name).

% ends a chunk, puts `no' so that no arithemtics cannot take place further
c_chunk_end:-
  bb_let(c_chunk,in,no).

%  finds/adds fun_symbol + fun_arity
%  if new functor increments code ofset (P-area)
%  also counts instruction i.e. increments No
newP(F,N,K):- 
  bb_val(c_chunk,in,No), 
  integer(No),
  c_find_fun(F,N,No,K).

newH_oldP(O):-c_check,new_offset(O).

oldH_oldP(O):-c_check,get_offset(O).

newH_newP(F,N,No,O):-newP(F,N,No),new_offset(O).

oldH_newP(F,N,No,O):-newP(F,N,No),get_offset(O).

c_wvoid(Times,O):-  
  newH_oldP(O),
  ( for(_,2,Times),
    new_offset(_),
    fail
  ; true
  ).

c_aux_load_integer(An, F, _, load_integer(An,F)):-integer(F),!,
  c_check.
c_aux_load_integer(An, F, N, load_constant(An,No)):-
  newP(F,N,No).

c_aux_put_integer(An, F, _, put_integer(F,An)):-integer(F),!,
  c_check.
c_aux_put_integer(An, F, N, put_constant(No,An)):-
  newP(F,N,No).

c_aux_get_integer(An, F, _, get_integer(F,An)):-integer(F),!,
  c_check.
c_aux_get_integer(An, F, N, get_constant(No,An)):-
  newP(F,N,No).

c_aux_write_integer(F, _, write_integer(O,F)):-integer(F),!,
  % Max is 1<<15, F > -Max, F < Max,
  newH_oldP(O).  
c_aux_write_integer(F, N, write_constant(O,No)):-
  newH_newP(F,N,No,O).  

c_aux_unify_integer(F, _, unify_integer(O,F)):-integer(F),!,
  oldH_oldP(O).  
c_aux_unify_integer(F, N, unify_constant(O,No)):-
  oldH_newP(F,N,No,O).

% trace=>generates code which prints out C-ified operations
% begin_end=>generates begin...end c_chunk for byte code on file



c_trace(Level,Instr):-  bb_val(c_flag,trace,X),X>=Level, % $$$
  !,
%  ttyprint(generating(Instr)),
  write_c_chunk((
  write('c_trace(" '),write(Instr),write(' ")'),nl
  )).
c_trace(_,_).

